perm filename GRASAI.SAI[S,HE]1 blob
sn#543712 filedate 1982-05-09 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00020 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00004 00002 ENTRY
C00007 00003 PROCEDURE XMITMESS(INTEGER JOBNO(alljobs))
C00011 00004 PROCEDURE RCVMESS(INTEGER JOBNO)
C00013 00005 PROCEDURE PUTMARK
C00016 00006 REAL PROCEDURE GETREAL(INTEGER JOBNO(defaultjob))
C00018 00007 INTEGER PROCEDURE JOBINIT(STRING JOBNAME INTEGER MODE(1))
C00022 00008 INTEGER PROCEDURE FILEINIT(STRING FILENAME INTEGER MODE(0))
C00023 00009 INTERNAL INTEGER PROCEDURE DDJOB RETURN(JOBINIT("DDJOB",1))
C00025 00010 INTERNAL INTEGER PROCEDURE KILJOB(INTEGER JOBNO)
C00027 00011 INTERNAL INTEGER PROCEDURE QUASH(INTEGER JOBNO)
C00030 00012 INTERNAL INTEGER PROCEDURE DETJOB(INTEGER JOBNO STRING FILENAME)
C00033 00013 INTERNAL PROCEDURE DDINIT
C00036 00014 INTERNAL PROCEDURE RECTAN(REAL X1,Y1,X2,Y2)
C00039 00015 INTERNAL PROCEDURE FNTSEL(INTEGER F STRING FNTNAM) comment select a font
C00042 00016 INTERNAL PROCEDURE PICFIL(REAL X1,Y1,X2,Y2 STRING FILENAME)
C00043 00017 INTERNAL INTEGER PROCEDURE GDDCHN(INTEGER CHAN,JOBNO(defaultjob))
C00046 00018 INTERNAL PROCEDURE PPPOS(REAL YLO,YHI)
C00049 00019 INTERNAL BOOLEAN PROCEDURE MAPSET(REAL PROCEDURE F INTEGER JOBNO(defaultjob))
C00053 00020 INTERNAL INTEGER PROCEDURE DDSIZ(INTEGER JOBNO(defaultjob))
C00057 ENDMK
C⊗;
ENTRY;
BEGIN "GRASAI"
REQUIRE "FILHDR.SAI[VIS,HPM]" SOURCE_FILE;
REQUIRE "GRANAM.SAI[GOD,HPM]" SOURCE_FILE;
DEFINE NJOBMAX=16, NFILMAX=16;
REQUIRE "GRASAI.DEF[HDR,HE]" SOURCE_FILE;
PRELOAD_WITH 0,0; INTEGER ARRAY NACTIVE[0:1];
comment NACTIVE tells how many graphics jobs are active. NACTIVE[0] is
the number of files open and NACTIVE[1] is the number of PTYs
running graphics jobs. --AAM 10-23-80;
INTEGER ARRAY ACTIVE[-NFILMAX:NJOBMAX];
comment ACTIVE tells information about the active graphics jobs. Files
are stored in the <0 positions. PTY jobs are stored in the
>0 positions. The 0 position is not used. For files, the negative
of the channel number is stored. For PTY jobs the line number (TTY #)
of the PTY is stored in the left halfword and the
job number of the graphics job is stored in the right
halfword. --AAM 10-23-80;
INTEGER ARRAY JOBNAM[1:NJOBMAX];
PRELOAD_WITH 32; INTEGER ARRAY TSP[1:1];
PRELOAD_WITH 0; INTEGER ARRAY MSP[1:1];
INTEGER ARRAY MESSAGE,TIDINGS[1:32];
INTEGER LASTJOB;
INTEGER BRCHAR,EOF,CHN,FLAG,COUNT;
PROCEDURE XMITMESS(INTEGER JOBNO(alljobs));
comment send MESSAGE to all jobs, default job, or job JOBNO;
BEGIN
INTEGER I;
comment if message buffer empty don't do anything --AAM 10-23-80;
IF MSP[1]=0 THEN RETURN;
comment if sending to a file then skip the job stuff. --AAM 10-23-80;
if jobno>0 then begin "nonfile"
IF NACTIVE[1]>0 THEN
BEGIN "send messages"
INTEGER J,N; INTEGER ARRAY FLG[1:NACTIVE[1]], HD[1:2];
comment FLG[I] is set to -1 when job I is found dead and to 1 when
a successful MAIL to job I is done. --AAM 10-23-80;
IF JOBNO=defaultjob THEN JOBNO←ACTIVE[1];
ARRCLR(FLG);
comment N is the number of jobs we need to send to --AAM 10-23-80;
N←IF JOBNO=alljobs THEN NACTIVE[1] ELSE 1;
DO
BEGIN
FOR I←1 STEP 1 UNTIL NACTIVE[1] DO IF JOBNO=alljobs ∨ JOBNO=ACTIVE[I] THEN
IF FLG[I]=0 THEN
BEGIN
IF (ACTIVE[I] LSH -18)≠0 THEN PTYALL(ACTIVE[I] LSH -18);
HD[1]←ACTIVE[I] LAND '777777; HD[2]←LOCATION(MESSAGE[1]);
J←0;
START_CODE MAIL 0,ACCESS(HD[1]); comment SEND; SETOM J; END;
IF J=0 THEN BEGIN N←N-1; FLG[I]←1; END ELSE
IF (CALL(ACTIVE[I] LAND '777777,"JBTSTS") LAND '400000000000)=0 ∨
(CALL(ACTIVE[I] LAND '777777,"GETNAM")≠JOBNAM[I] ∧
CALL(ACTIVE[I] LAND '777777,"GETNAM")≠CVSIX("READY!")) THEN
BEGIN N←N-1; FLG[I]←-1; PRINT(CV6STR(JOBNAM[I])," died",'15&'12); END;
END;
IF N≠0 THEN CALL(1,"SLEEP");
END UNTIL N=0;
comment Clean up dead jobs. --AAM 10-23-80;
FOR I←1 STEP 1 UNTIL NACTIVE[1] DO IF JOBNO=alljobs∨JOBNO=ACTIVE[1] THEN
IF FLG[I]=-1 THEN
BEGIN
IF (ACTIVE[I] LSH -18)≠0 THEN PTYREL(ACTIVE[I] LSH -18);
JOBNAM[I]←JOBNAM[NACTIVE[1]];
ACTIVE[I]←ACTIVE[NACTIVE[1]];
FLG[I]←FLG[NACTIVE[1]];
NACTIVE[1]←NACTIVE[1]-1;
I←I-1;
END;
END;
end "nonfile";
if (jobno<0) or jobno=alljobs then begin "file"
IF NACTIVE[0]>0 THEN
BEGIN "write into files"
FOR I←-1 STEP -1 UNTIL -NACTIVE[0] DO IF JOBNO=alljobs ∨ JOBNO=ACTIVE[I] THEN
ARRYOUT(-ACTIVE[I],MESSAGE[1],32);
END;
end "file";
MSP[1]←0;
END;
PROCEDURE RCVMESS(INTEGER JOBNO);
comment wait to recieve a message from an active job;
IF NACTIVE[1]>0 THEN
BEGIN
INTEGER I,J;
IF JOBNO=defaultjob THEN JOBNO←ACTIVE[1];
IF TSP[1]=0 THEN RETURN; TSP[1]←0;
FOR I←1 STEP 1 UNTIL NACTIVE[1] DO IF ACTIVE[I]=JOBNO THEN DONE;
IF I>NACTIVE[1] THEN PRINT("job ",JOBNO," not activated ",'15&'12);
DO
BEGIN
J←0; START_CODE MAIL 3,0; comment SKPME; SETOM J; END;
IF J≠0 THEN
BEGIN
IF (CALL(ACTIVE[I] LAND '777777,"JBTSTS") LAND '400000000000)=0 ∨
(CALL(ACTIVE[I] LAND '777777,"GETNAM")≠JOBNAM[I] ∧
CALL(ACTIVE[I] LAND '777777,"GETNAM")≠CVSIX("READY!")) THEN
BEGIN PRINT(CV6STR(JOBNAM[I])," died",'15&'12); RETURN; END
ELSE CALL(0,"SLEEP");
END;
END
UNTIL J=0;
START_CODE MAIL 1,ACCESS(TIDINGS[1]); comment WRCV; END;
END;
PROCEDURE PUTMARK;
IF (NACTIVE[0]+NACTIVE[1])>0 THEN
BEGIN
IF MSP[1]=0 THEN RETURN;
MSP[1]←MSP[1]+1;
MESSAGE[MSP[1]]←MARK_;
XMITMESS(alljobs); comment --AAM 10/23/80;
END;
PROCEDURE PUTREAL(REAL V; INTEGER JOBNO(alljobs));
IF (NACTIVE[0]+NACTIVE[1])>0 THEN
BEGIN
IF JOBNO≠LASTJOB THEN BEGIN PUTMARK; LASTJOB←JOBNO; END;;
MSP[1]←MSP[1]+1;
MEMORY[LOCATION(MESSAGE[MSP[1]]),REAL]←V;
IF MSP[1]=32 THEN XMITMESS(JOBNO);
END;
PROCEDURE PUTINT(INTEGER V, JOBNO(alljobs));
IF (NACTIVE[0]+NACTIVE[1])>0 THEN
BEGIN
IF JOBNO≠LASTJOB THEN BEGIN PUTMARK; LASTJOB←JOBNO; END;;
MSP[1]←MSP[1]+1;
MESSAGE[MSP[1]]←V;
IF MSP[1]=32 THEN XMITMESS(JOBNO);
END;
PROCEDURE PUTSTRING(STRING V; INTEGER JOBNO(alljobs));
IF (NACTIVE[0]+NACTIVE[1])>0 THEN
BEGIN
INTEGER I,L;
IF JOBNO≠LASTJOB THEN BEGIN PUTMARK; LASTJOB←JOBNO; END;;
PUTINT(L←LENGTH(V),JOBNO); L←(L+4)%5;
FOR I←1 STEP 1 UNTIL L DO
BEGIN
PUTINT(CVASC(V),JOBNO);
IF I≠L THEN V←V[6 TO ∞];
END;
END;
PROCEDURE PUTINTARRAY(REFERENCE INTEGER ARRY; INTEGER N, JOBNO(alljobs));
IF (NACTIVE[0]+NACTIVE[1])>0 THEN
BEGIN
INTEGER I;
IF JOBNO≠LASTJOB THEN BEGIN PUTMARK; LASTJOB←JOBNO; END;;
FOR I←0 STEP 1 UNTIL N-1 DO
PUTINT(MEMORY[LOCATION(ARRY)+N],JOBNO);
END;
REAL PROCEDURE GETREAL(INTEGER JOBNO(defaultjob));
IF NACTIVE[1]>0 THEN
BEGIN
IF JOBNO=defaultjob THEN JOBNO←ACTIVE[1];
IF TSP[1]=32 THEN RCVMESS(JOBNO);
TSP[1]←TSP[1]+1;
RETURN(MEMORY[LOCATION(TIDINGS[TSP[1]]),REAL]);
END;
INTEGER PROCEDURE GETINT(INTEGER JOBNO(defaultjob));
IF NACTIVE[1]>0 THEN
BEGIN
IF JOBNO=defaultjob THEN JOBNO←ACTIVE[1];
IF TSP[1]=32 THEN RCVMESS(JOBNO);
TSP[1]←TSP[1]+1;
RETURN(TIDINGS[TSP[1]]);
END;
PROCEDURE GETINTARRAY(REFERENCE INTEGER AR; INTEGER N,JOBNO(defaultjob));
IF NACTIVE[1]>0 THEN
BEGIN
INTEGER I;
FOR I←0 STEP 1 UNTIL N-1 DO MEMORY[LOCATION(AR)+I]←GETINT(JOBNO);
END;
INTEGER PROCEDURE JOBINIT(STRING JOBNAME; INTEGER MODE(1));
comment start graphics job: mode=0 means swap to the job,
mode=1 means start it on another job, and mode=2 means
prompt the user for the job number of an existing graphics
job. --AAM 10/23/80;
BEGIN "JOBINIT"
STRING S; INTEGER I,JN,LN,FOO;
INTEGER ARRAY HD[1:2],MESSAGE[1:32];
PUTMARK;
comment ACTIVATE NEW GRAPHICS JOB;
CASE MODE OF
BEGIN
[0] BEGIN JN←EXSWAP("DSK:"&JOBNAME&".DMP[1,3]"); LN←-1; END;
[1]
BEGIN
EXTERNAL INTEGER _SKIP_;
INTEGER ARRAY PTY[1:2]; STRING POU;
PTY[1]←LN←PTYGET;
IF _SKIP_=0 THEN JN←0 ELSE
BEGIN
PTY[2]←5; comment LOGIN function;
START_CODE PTYUUO '16,ACCESS(PTY[1]); comment PTJOBX; JUMP; END;
IF PTY[2]=0 THEN BEGIN JN←0; PTYREL(PTY[1]); END ELSE
BEGIN
STRING S;
SETBREAK(1,'12,'15,"INS");
PTOSTR(PTY[1],"TTY GAG"&'15&'12); S←PTYIN(PTY[1],1,FOO);
PTOSTR(PTY[1],"R "&JOBNAME&'15&'12); S←PTYIN(PTY[1],1,FOO);
JN←PTY[2];
POU←"";
DO POU←POU&PTCHRW(PTY[1]) UNTIL
EQU(POU[∞-5 TO ∞],"READY!") ∨
EQU(POU[∞-4 TO ∞],"found");
IF EQU(POU[∞-4 TO ∞],"found") THEN BEGIN PRINT(POU,'15&'12);
PTOSTR(PTY[1],"K/F"&'15&'12); CALL(1,"SLEEP");
PTYREL(PTY[1]); PTY[1]←0; JN←0; END;
PTOSTR(PTY[1],"∂"); comment control O;
END;
END;
END;
[2]
BEGIN
PRINT("JOB NUMBER OF ",JOBNAME,":"); JN←CVD(INCHWL);
LN←CALL(CALL(236,"PEEK")+JN,"PEEK") LAND '777777; comment JBTLIN;
END;
ELSE PRINT("illegal graphics job startup mode",'15&'12)
END;
IF JN=0 THEN BEGIN PRINT("no job slots for ",JOBNAME,'15&'12); RETURN(0); END
ELSE
BEGIN
ACTIVE[NACTIVE[1]←NACTIVE[1]+1]←JN LOR (LN LSH 18);
JOBNAM[NACTIVE[1]]←CVSIX(JOBNAME);
END;
comment AND MAIL IT OUR JOB NUMBER;
MESSAGE[1]←CALL(0,"PJOB"); MESSAGE[2]←CALL(-1,"GETNAM");
HD[1]←JN; HD[2]←LOCATION(MESSAGE[1]);
WHILE CALL(JN,"GETNAM")≠CVSIX("READY!") DO CALL(0,"SLEEP");
I←0; START_CODE MAIL 0,ACCESS(HD[1]); comment SEND; SETOM I; END;
IF I≠0 THEN
BEGIN
PRINT("couldn't send message to ",JOBNAME,'15&'12);
NACTIVE[1]←NACTIVE[1]-1;
RETURN(0);
END;
RETURN(JN LOR (LN LSH 18));
END "JOBINIT";
INTEGER PROCEDURE FILEINIT(STRING FILENAME; INTEGER MODE(0));
BEGIN "FILEINIT"
comment MODE=0, create new file, MODE=1, extend existing file;
comment Note, however that MODE is not implemented! ---AAM 10-23-80;
PUTMARK;
ACTIVE[-(NACTIVE[0]←NACTIVE[0]+1)]←-(CHN←GETCHAN);
PRSFIL(""); PRSFIL(FILENAME);
OPEN(CHN,DEVPRS,8,0,19,COUNT,BRCHAR,EOF);
ENTER(CHN,FILPRS,FLAG);
RETURN(-CHN);
END "FILEINIT";
INTERNAL INTEGER PROCEDURE DDJOB; RETURN(JOBINIT("DDJOB",1));
INTERNAL INTEGER PROCEDURE XGPJOB; RETURN(JOBINIT("XGPJOB",1));
INTERNAL INTEGER PROCEDURE SYNJOB(INTEGER HIG(480),WID(512),BIT(9));
BEGIN
INTEGER JN;
JN←JOBINIT("SYNJOB",1);
PUTINT(HIG,JN);
PUTINT(WID,JN);
PUTINT(BIT,JN);
XMITMESS(JN);
RETURN(JN);
END;
INTERNAL INTEGER PROCEDURE FILJOB(STRING FILENAME); RETURN(FILEINIT(FILENAME,2));
INTERNAL INTEGER PROCEDURE TSTJOB; RETURN(JOBINIT("TSTJOB",2));
INTERNAL INTEGER PROCEDURE GRNJOB(INTEGER HIG(480),WID(512),BIT(9));
BEGIN
INTEGER JN;
JN←JOBINIT("GRNJOB",1);
PUTINT(HIG,JN);
PUTINT(WID,JN);
PUTINT(BIT,JN);
XMITMESS(JN);
RETURN(JN);
END;
INTERNAL INTEGER PROCEDURE KILJOB(INTEGER JOBNO);
comment destroy JOBNO as if it had never been;
comment note that JOBNO MUST be a valid job number and cannot be alljobs
or defaultjob. --AAM 10/23/80;
BEGIN
INTEGER I;
PUTMARK; PUTINT(KILJOB_,JOBNO); XMITMESS(JOBNO);
IF JOBNO>0 THEN
BEGIN
IF (JOBNO LSH -18)≠0 THEN PTYREL(JOBNO LSH -18);
FOR I←1 STEP 1 UNTIL NACTIVE[1] DO IF ACTIVE[I]=JOBNO THEN
BEGIN ACTIVE[I]←ACTIVE[NACTIVE[1]];
JOBNAM[I]←JOBNAM[NACTIVE[1]];
NACTIVE[1]←NACTIVE[1]-1; RETURN(JOBNO); END;
END
ELSE
BEGIN
CLOSE(-JOBNO); RELEASE(-JOBNO);
FOR I←-1 STEP -1 UNTIL -NACTIVE[0] DO IF ACTIVE[I]=JOBNO THEN
BEGIN ACTIVE[I]←ACTIVE[-NACTIVE[0]];
NACTIVE[0]←NACTIVE[0]-1; RETURN(JOBNO); END;
END;
RETURN(0);
END;
INTERNAL INTEGER PROCEDURE QUASH(INTEGER JOBNO);
comment prevent commands from being sent to JOBNO;
comment note that JOBNO MUST be a valid job number and cannot be alljobs
or defaultjob. --AAM 10/23/80;
BEGIN
INTEGER I;
PUTMARK;
IF JOBNO>0 THEN
BEGIN
FOR I←1 STEP 1 UNTIL NACTIVE[1] DO IF ACTIVE[I]=JOBNO THEN
BEGIN ACTIVE[I]←ACTIVE[NACTIVE[1]];
JOBNAM[I]←JOBNAM[NACTIVE[1]];
NACTIVE[1]←NACTIVE[1]-1; RETURN(JOBNO); END
END
ELSE
FOR I←-1 STEP -1 UNTIL -NACTIVE[0] DO IF ACTIVE[I]=JOBNO THEN
BEGIN ACTIVE[I]←ACTIVE[-NACTIVE[0]];
NACTIVE[0]←NACTIVE[0]-1; RETURN(JOBNO); END;
RETURN(0);
END;
INTERNAL INTEGER PROCEDURE INCITE(INTEGER JOBNO);
comment resume sending commands to JOBNO;
comment note that JOBNO MUST be a valid job number and cannot be alljobs
or defaultjob. --AAM 10/23/80;
BEGIN
INTEGER I;
PUTMARK;
FOR I←1 STEP 1 UNTIL NACTIVE[1] DO IF ACTIVE[I]=JOBNO THEN RETURN(0);
FOR I←-1 STEP -1 UNTIL -NACTIVE[0] DO IF ACTIVE[I]=JOBNO THEN RETURN(0);
IF JOBNO>0 THEN
BEGIN
ACTIVE[NACTIVE[1]←NACTIVE[1]+1]←JOBNO;
JOBNAM[NACTIVE[1]]←CALL(JOBNO LAND '777777,"GETNAM");
END
ELSE
BEGIN
ACTIVE[-(NACTIVE[0]←NACTIVE[0]+1)]←JOBNO;
END;
RETURN(JOBNO);
END;
INTERNAL INTEGER PROCEDURE DETJOB(INTEGER JOBNO; STRING FILENAME);
comment permanently forget JOBNO, but let it run detached processing FILENAME;
comment note that JOBNO MUST be a valid job number and cannot be alljobs
or defaultjob. --AAM 10/23/80;
BEGIN
INTEGER I;
PUTMARK;
PRSFIL(FILENAME);
PUTINT(DISOWN_,JOBNO); PUTINT(GRAFIL_,JOBNO);
PUTSTRING(DEVPRS&":"&FILPRS,JOBNO); XMITMESS(JOBNO);
IF JOBNO>0 THEN
BEGIN
IF (JOBNO LSH -18)≠0 THEN
BEGIN
INTEGER ARRAY PTY[1:2];
PTY[1]←JOBNO LSH -18;
PTY[2]←'11; comment PDETACH function;
START_CODE LABEL FOO;
FOO: PTYUUO '16,ACCESS(PTY[1]); comment PTJOBX; JRST FOO; END;
WHILE CALL(JOBNO LSH -18,"TTYJOB")≠0 DO CALL(0,"SLEEP");
PTYREL(JOBNO LSH -18);
END;
FOR I←1 STEP 1 UNTIL NACTIVE[1] DO IF ACTIVE[I]=JOBNO THEN
BEGIN ACTIVE[I]←ACTIVE[NACTIVE[1]];
JOBNAM[I]←JOBNAM[NACTIVE[1]];
NACTIVE[1]←NACTIVE[1]-1; RETURN(JOBNO); END;
END
ELSE
BEGIN
CLOSE(-JOBNO); RELEASE(-JOBNO);
FOR I←-1 STEP -1 UNTIL -NACTIVE[0] DO IF ACTIVE[I]=JOBNO THEN
BEGIN ACTIVE[I]←ACTIVE[-NACTIVE[0]];
NACTIVE[0]←NACTIVE[0]-1; RETURN(JOBNO); END;
END;
RETURN(0);
END;
INTERNAL PROCEDURE DDINIT;
comment clear the screen;
BEGIN PUTINT(DDINIT_); END;
INTERNAL PROCEDURE GRAFIL(STRING FILENAME);
BEGIN PUTINT(GRAFIL_); PUTSTRING(FILENAME); XMITMESS; END;
INTERNAL PROCEDURE SCREEN(REAL XLO,YLO,XHI,YHI);
comment declare the full screen dimensions;
BEGIN
PUTINT(SCREEN_);
PUTREAL(XLO);
PUTREAL(YLO);
PUTREAL(XHI);
PUTREAL(YHI);
END;
INTERNAL PROCEDURE SCREEM(REFERENCE REAL XLO,YLO,XHI,YHI; INTEGER JOBNO(defaultjob));
comment returns the full screen dimensions;
BEGIN
PUTINT(SCREEM_,JOBNO);
XMITMESS(JOBNO); RCVMESS(JOBNO);
XLO←GETREAL(JOBNO);
YLO←GETREAL(JOBNO);
XHI←GETREAL(JOBNO);
YHI←GETREAL(JOBNO);
END;
INTERNAL PROCEDURE DRKEN; PUTINT(DRKEN_);
comment cause subsequent outputs to be dark;
INTERNAL PROCEDURE LITEN; PUTINT(LITEN_);
comment cause them to be light;
INTERNAL PROCEDURE INVEN; PUTINT(INVEN_);
comment cause them to invert the state of things;
INTERNAL PROCEDURE DOT(REAL X,Y; INTEGER TH(0));
comment display a point at X,Y;
BEGIN
PUTINT(DOT_);
PUTREAL(X);
PUTREAL(Y);
PUTINT(TH);
END;
INTERNAL PROCEDURE LINE(REAL X1,Y1,X2,Y2; INTEGER TH(0));
comment display a line;
BEGIN
PUTINT(LINE_);
PUTREAL(X1);
PUTREAL(Y1);
PUTREAL(X2);
PUTREAL(Y2);
PUTINT(TH);
END;
INTERNAL PROCEDURE RECTAN(REAL X1,Y1,X2,Y2);
comment fill in rectangle;
BEGIN
PUTINT(RECTAN_);
PUTREAL(X1);
PUTREAL(Y1);
PUTREAL(X2);
PUTREAL(Y2);
END;
INTERNAL PROCEDURE ELLIPS(REAL X1,Y1,X2,Y2);
comment fill ellipse bounded by X1,Y1,X2,Y2;
BEGIN
PUTINT(ELLIPS_);
PUTREAL(X1);
PUTREAL(Y1);
PUTREAL(X2);
PUTREAL(Y2);
END;
INTERNAL PROCEDURE POLYGO(INTEGER N; REFERENCE REAL X,Y);
comment fill in a polygon (concave and star ok);
BEGIN
INTEGER I;
PUTINT(POLYGO_);
PUTINT(N);
FOR I←0 STEP 1 UNTIL N-1 DO
BEGIN
PUTREAL(MEMORY[LOCATION(X)+I,REAL]);
PUTREAL(MEMORY[LOCATION(Y)+I,REAL]);
END;
END;
INTERNAL PROCEDURE TXTPOS(REAL X,Y,XS,YS,DXS(0),DYS(0));
comment postion text with lower left at X,Y, height YS, width XS;
BEGIN
PUTINT(TXTPOS_);
PUTREAL(X);
PUTREAL(Y);
PUTREAL(XS);
PUTREAL(YS);
PUTREAL(DXS);
PUTREAL(DYS);
END;
INTERNAL PROCEDURE TEXT(STRING TXT); comment vector characters;
BEGIN
PUTINT(TEXT_);
PUTSTRING(TXT);
END;
INTERNAL PROCEDURE TEXTD(STRING TXT); comment dot chars;
BEGIN
PUTINT(TEXTD_);
PUTSTRING(TXT);
END;
INTERNAL PROCEDURE FNTSEL(INTEGER F; STRING FNTNAM); comment select a font;
BEGIN
PUTINT(FNTSEL_);
PUTINT(F);
PUTSTRING(FNTNAM);
END;
INTERNAL PROCEDURE FNTPOS(REAL XP,YP,XS,YS,DXS,DYS);
BEGIN
PUTINT(FNTPOS_);
PUTREAL(XP);
PUTREAL(YP);
PUTREAL(XS);
PUTREAL(YS);
PUTREAL(DXS);
PUTREAL(DYS);
END;
INTERNAL PROCEDURE FNTEXT(REAL X,Y; INTEGER F; STRING TXT); comment fonty characters;
BEGIN
PUTINT(FNTEXT_);
PUTREAL(X);
PUTREAL(Y);
PUTINT(F);
PUTSTRING(TXT);
END;
INTERNAL PROCEDURE FNTLIN(REAL X1,Y1,X2,Y2; INTEGER THIK(0));
BEGIN
PUTINT(FNTLIN_);
PUTREAL(X1);
PUTREAL(Y1);
PUTREAL(X2);
PUTREAL(Y2);
PUTINT(THIK);
END;
INTERNAL PROCEDURE FNTDOT(REAL X1,Y1; INTEGER THIK(0));
BEGIN
PUTINT(FNTDOT_);
PUTREAL(X1);
PUTREAL(Y1);
PUTINT(THIK);
END;
INTERNAL PROCEDURE FNTREC(REAL X1,Y1,X2,Y2);
BEGIN
PUTINT(FNTREC_);
PUTREAL(X1);
PUTREAL(Y1);
PUTREAL(X2);
PUTREAL(Y2);
END;
INTERNAL PROCEDURE FNTELL(REAL X1,Y1,X2,Y2);
BEGIN
PUTINT(FNTELL_);
PUTREAL(X1);
PUTREAL(Y1);
PUTREAL(X2);
PUTREAL(Y2);
END;
INTERNAL PROCEDURE FNTPOL(INTEGER N; REFERENCE REAL X,Y);
BEGIN
INTEGER I;
PUTINT(FNTPOL_);
PUTINT(N);
FOR I←0 STEP 1 UNTIL N-1 DO
BEGIN
PUTREAL(MEMORY[LOCATION(X)+I,REAL]);
PUTREAL(MEMORY[LOCATION(Y)+I,REAL]);
END;
END;
INTERNAL PROCEDURE PICFIL(REAL X1,Y1,X2,Y2; STRING FILENAME);
BEGIN
PUTINT(PICFIL_);
PUTREAL(X1);
PUTREAL(Y1);
PUTREAL(X2);
PUTREAL(Y2);
PUTSTRING(FILENAME);
END;
INTERNAL PROCEDURE PICFIT(REAL X1,Y1,X2,Y2; STRING FILENAME);
BEGIN
PUTINT(PICFIT_);
PUTREAL(X1);
PUTREAL(Y1);
PUTREAL(X2);
PUTREAL(Y2);
PUTSTRING(FILENAME);
END;
INTERNAL INTEGER PROCEDURE GDDCHN(INTEGER CHAN,JOBNO(defaultjob));
comment get a DD channel (-1 for any, failure);
BEGIN
PUTINT(GDDCHN_,JOBNO); PUTINT(CHAN,JOBNO);
XMITMESS(JOBNO); RCVMESS(JOBNO);
RETURN(GETINT(JOBNO));
END;
INTERNAL PROCEDURE RDDCHN(INTEGER CHAN);
comment release a channel;
BEGIN
PUTINT(RDDCHN_);
PUTINT(CHAN);
END;
INTERNAL PROCEDURE ERASE(INTEGER CHAN);
comment clear a DD channel (-1 means yours);
BEGIN
PUTINT(ERASE_);
PUTINT(CHAN);
END;
INTERNAL PROCEDURE DPYUP(INTEGER CHAN,BUFFER(-1));
comment Deposit the buffer on DD channel CHAN;
BEGIN
PUTINT(DPYUP_);
PUTINT(CHAN);
PUTINT(BUFFER);
XMITMESS;
END;
INTERNAL PROCEDURE PJUP;
comment send buffer to MOS display on PDP11;
BEGIN
PUTINT(PJUP_);
XMITMESS;
END;
INTERNAL PROCEDURE SHOW(INTEGER CHAN,LIN(-1));
comment video switch LIN (-1 for yours) to CHAN;
BEGIN
PUTINT(SHOW_);
PUTINT(CHAN);
PUTINT(LIN);
XMITMESS;
END;
INTERNAL PROCEDURE SHOWA(INTEGER CHAN,LIN(-1));
comment add CHAN to LIN;
BEGIN
PUTINT(SHOWA_);
PUTINT(CHAN);
PUTINT(LIN);
XMITMESS;
END;
INTERNAL PROCEDURE SHOWS(INTEGER CHAN,LIN(-1));
comment subtract CHAN from LIN;
BEGIN
PUTINT(SHOWS_);
PUTINT(CHAN);
PUTINT(LIN);
XMITMESS;
END;
INTERNAL PROCEDURE PPPOS(REAL YLO,YHI);
comment position page printer between YLO,YHI;
BEGIN
PUTINT(PPPOS_);
PUTREAL(YLO);
PUTREAL(YHI);
END;
INTERNAL PROCEDURE XGPUP(INTEGER SIZE);
comment send the DD buffer to the XGP, SIZE=-5 to +5;
BEGIN
PUTINT(XGPUP_);
PUTINT(SIZE);
END;
INTERNAL PROCEDURE XGPQUE(INTEGER SIZE);
comment like XGPUP, but creates a new job to do XGPing;
BEGIN
PUTINT(XGPQUE_);
PUTINT(SIZE);
END;
INTERNAL PROCEDURE DDFONT(REAL X1,Y1,X2,Y2; STRING FONTFIL;
INTEGER CHAR("A"),BASE(0),LKERN(0),RKERN(0));
comment insert DD buffer bounded by X1,Y1,X2,Y2 into font file;
BEGIN
PUTINT(DDFONT_);
PUTREAL(X1); PUTREAL(Y1); PUTREAL(X2); PUTREAL(Y2); PUTSTRING(FONTFIL);
PUTINT(CHAR); PUTINT(BASE); PUTINT(LKERN); PUTINT(RKERN);
END;
INTERNAL PROCEDURE DDPAK(INTEGER I; REFERENCE INTEGER LBUF; INTEGER J1,J2, JOBNO(defaultjob));
comment pack scnln I bet. J1,J2 into LBUF 36 bt/wrd;
BEGIN
PUTINT(DDPAK_,JOBNO);
PUTINT(I,JOBNO); PUTINT(LBUF,JOBNO); PUTINT(J1,JOBNO); PUTINT(J2,JOBNO);
XMITMESS(JOBNO); RCVMESS(JOBNO);
GETINTARRAY(LBUF,(ABS(J2-J1)+36)%36,JOBNO);
END;
INTERNAL INTEGER PROCEDURE SYNMAP(INTEGER ORDER,JOBNO(defaultjob));
comment which channels are the video synthesizer's;
comment ORDER=0 is most significant + or - 1 next, etc.;
BEGIN
PUTINT(SYNMAP_,JOBNO);
PUTINT(ORDER,JOBNO);
XMITMESS(JOBNO); RCVMESS(JOBNO);
RETURN(GETINT(JOBNO));
END;
INTERNAL BOOLEAN PROCEDURE MAPSET(REAL PROCEDURE F; INTEGER JOBNO(defaultjob));
comment set vid inten table. F(X) is real [0,1]→[0,1];
BEGIN
PUTINT(MAPSET_,JOBNO);
comment Transmit a PROCEDURE via interjob mail?? ;
comment you've got to be kidding! ;
XMITMESS(JOBNO); RCVMESS(JOBNO);
RETURN(GETINT(JOBNO));
END;
INTERNAL BOOLEAN PROCEDURE MAPMON(REAL P; INTEGER JOBNO(defaultjob));
comment set v.i.t. to a monotonic function X↑P;
BEGIN
PUTINT(MAPMON_,JOBNO);
PUTREAL(P,JOBNO);
XMITMESS(JOBNO); RCVMESS(JOBNO);
RETURN(GETINT(JOBNO));
END;
INTERNAL BOOLEAN PROCEDURE MAPGRY(REAL P; INTEGER JOBNO(defaultjob));
comment set vit to a gray coded monotonic function X↑P;
BEGIN
PUTINT(MAPGRY_,JOBNO);
PUTREAL(P,JOBNO);
XMITMESS(JOBNO); RCVMESS(JOBNO);
RETURN(GETINT(JOBNO));
END;
INTERNAL PROCEDURE LINSCN(INTEGER N; REFERENCE INTEGER MAP; INTEGER DT,LINENO);
comment scan channels in MAP at rate DT;
BEGIN
PUTINT(LINSCN_);
PUTINT(N); PUTINTARRAY(MAP,N); PUTINT(DT); PUTINT(LINENO);
XMITMESS;
END;
INTERNAL PROCEDURE MAPSCN(INTEGER N; REFERENCE INTEGER MAP; INTEGER DT,LINENO);
comment LINSCN, but VDS bit maps in MAP;
BEGIN
PUTINT(MAPSCN_);
PUTINT(N); PUTINTARRAY(MAP,N); PUTINT(DT); PUTINT(LINENO);
XMITMESS;
END;
INTERNAL PROCEDURE SCNOFF;
comment turn off the scanning (in SW mode);
BEGIN
PUTINT(SCNOFF_);
XMITMESS;
END;
INTERNAL PROCEDURE SCNFRZ;
comment SCNOFF, but doesn't restore screen;
BEGIN
PUTINT(SCNFRZ_);
XMITMESS;
END;
INTERNAL PROCEDURE SCNINC(INTEGER INC);
comment change the stepsize in the scan;
BEGIN
PUTINT(SCNINC_);
PUTINT(INC);
XMITMESS;
END;
INTERNAL INTEGER PROCEDURE DDSIZ(INTEGER JOBNO(defaultjob));
BEGIN
PUTINT(DDSIZ_,JOBNO); XMITMESS(JOBNO); RCVMESS(JOBNO);
RETURN(GETINT(JOBNO));
END;
INTERNAL PROCEDURE DDSTOR(REFERENCE INTEGER DDARRAY; INTEGER JOBNO(defaultjob));
comment store the buffer in an array;
BEGIN
INTEGER SIZ;
SIZ←DDSIZ(JOBNO);
PUTINT(DDSTOR_,JOBNO); XMITMESS(JOBNO); RCVMESS(JOBNO);
GETINTARRAY(DDARRAY,SIZ,JOBNO);
END;
INTERNAL PROCEDURE DDLOAD(REFERENCE INTEGER DDARRAY; INTEGER JOBNO(defaultjob));
comment load the buffer from an array;
BEGIN
INTEGER SIZ;
SIZ←DDSIZ(JOBNO);
PUTINT(DDLOAD_,JOBNO);
PUTINTARRAY(DDARRAY,SIZ,JOBNO);
XMITMESS(JOBNO);
END;
INTERNAL PROCEDURE DDOR(REFERENCE INTEGER DDARRAY; INTEGER JOBNO(defaultjob));
comment or an array into the buffer;
BEGIN
INTEGER SIZ;
SIZ←DDSIZ(JOBNO);
PUTINT(DDOR_,JOBNO);
PUTINTARRAY(DDARRAY,SIZ,JOBNO);
XMITMESS(JOBNO);
END;
INTERNAL PROCEDURE DDAND(REFERENCE INTEGER DDARRAY; INTEGER JOBNO(defaultjob));
comment and the buffer with an array;
BEGIN
INTEGER SIZ;
SIZ←DDSIZ(JOBNO);
PUTINT(DDAND_,JOBNO);
PUTINTARRAY(DDARRAY,SIZ,JOBNO);
XMITMESS(JOBNO);
END;
INTERNAL PROCEDURE DDEXCH(REFERENCE INTEGER DDARRAY; INTEGER JOBNO(defaultjob));
comment exchange an array with the buffer;
BEGIN
INTEGER SIZ;
SIZ←DDSIZ(JOBNO);
PUTINT(DDEXCH_,JOBNO);
PUTINTARRAY(DDARRAY,SIZ,JOBNO);
XMITMESS(JOBNO);
RCVMESS(JOBNO);
GETINTARRAY(DDARRAY,SIZ,JOBNO);
END;
INTERNAL PROCEDURE GETDDF(STRING FILNAME);
comment load the buffer from a file;
BEGIN
PUTINT(GETDDF_); PUTSTRING(FILNAME);
END;
INTERNAL PROCEDURE PUTDDF(STRING FILNAME);
comment save the buffer in a file;
BEGIN
PUTINT(PUTDDF_); PUTSTRING(FILNAME);
END;
INTERNAL PROCEDURE GETMIT(STRING FILNAME);
comment load the buffer from a file;
BEGIN
PUTINT(GETMIT_); PUTSTRING(FILNAME);
END;
INTERNAL PROCEDURE PUTMIT(STRING FILNAME);
comment save the buffer in a file;
BEGIN
PUTINT(PUTMIT_); PUTSTRING(FILNAME);
END;
END "GRASAI";